home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_emacs.idb / usr / freeware / share / emacs / 19.34 / lisp / simula.el.z / simula.el
Encoding:
Text File  |  1998-10-28  |  61.2 KB  |  1,674 lines
  1. ;;; simula.el --- SIMULA 87 code editing commands for Emacs
  2.  
  3. ;; Copyright (C) 1992, 1994, 1996 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Hans Henrik Eriksen <hhe@ifi.uio.no>
  6. ;; Maintainer: simula-mode@ifi.uio.no
  7. ;; Adapted-By: ESR
  8. ;; Keywords: languages
  9.  
  10. ;; This file is part of GNU Emacs.
  11.  
  12. ;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;; it under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;; GNU General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25. ;; Boston, MA 02111-1307, USA.
  26.  
  27. ;;; Commentary:
  28.  
  29. ;; A major mode for editing the Simula language.  It knows about Simula
  30. ;; syntax and standard indentation commands.  It also provides convenient
  31. ;; abbrevs for Simula keywords.
  32. ;;
  33. ;; Hans Henrik Eriksen (the author) may be reached at:
  34. ;;         Institutt for informatikk,
  35. ;;         Universitetet i Oslo
  36.  
  37. ;;; Code:
  38.  
  39.  
  40. (defconst simula-tab-always-indent-default nil
  41.   "Non-nil means TAB in SIMULA mode should always reindent the current line.
  42. Otherwise TAB indents only when point is within
  43. the run of whitespace at the beginning of the line.")
  44.  
  45. (defvar simula-tab-always-indent simula-tab-always-indent-default
  46.   "*Non-nil means TAB in SIMULA mode should always reindent the current line.
  47. Otherwise TAB indents only when point is within
  48. the run of whitespace at the beginning of the line.")
  49.  
  50. (defconst simula-indent-level-default 3
  51.   "Indentation of SIMULA statements with respect to containing block.")
  52.  
  53. (defvar simula-indent-level simula-indent-level-default
  54.   "*Indentation of SIMULA statements with respect to containing block.")
  55.  
  56. (defconst simula-substatement-offset-default 3
  57.   "Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.")
  58.  
  59. (defvar simula-substatement-offset simula-substatement-offset-default
  60.   "*Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.")
  61.  
  62. (defconst simula-continued-statement-offset-default 3
  63.   "Extra indentation for lines not starting a statement or substatement.
  64. If value is a list, each line in a multipleline continued statement
  65. will have the car of the list extra indentation with respect to
  66. the previous line of the statement.")
  67.  
  68. (defvar simula-continued-statement-offset simula-continued-statement-offset-default
  69.   "*Extra indentation for lines not starting a statement or substatement.
  70. If value is a list, each line in a multipleline continued statement
  71. will have the car of the list extra indentation with respect to
  72. the previous line of the statement.")
  73.  
  74. (defconst simula-label-offset-default -4711
  75.   "Offset of SIMULA label lines relative to usual indentation.")
  76.  
  77. (defvar simula-label-offset simula-label-offset-default
  78.   "*Offset of SIMULA label lines relative to usual indentation.")
  79.  
  80. (defconst simula-if-indent-default '(0 . 0)
  81.   "Extra indentation of THEN and ELSE with respect to the starting IF.
  82. Value is a cons cell, the car is extra THEN indentation and the cdr
  83. extra ELSE indentation.  IF after ELSE is indented as the starting IF.")
  84.  
  85. (defvar simula-if-indent simula-if-indent-default
  86.   "*Extra indentation of THEN and ELSE with respect to the starting IF.
  87. Value is a cons cell, the car is extra THEN indentation and the cdr
  88. extra ELSE indentation.  IF after ELSE is indented as the starting IF.")
  89.  
  90. (defconst simula-inspect-indent-default '(0 . 0)
  91.   "Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
  92. Value is a cons cell, the car is extra WHEN indentation
  93. and the cdr extra OTHERWISE indentation.")
  94.  
  95. (defvar simula-inspect-indent simula-inspect-indent-default
  96.   "*Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
  97. Value is a cons cell, the car is extra WHEN indentation
  98. and the cdr extra OTHERWISE indentation.")
  99.  
  100. (defconst simula-electric-indent-default nil
  101.   "Non-nil means `simula-indent-line' function may reindent previous line.")
  102.  
  103. (defvar simula-electric-indent simula-electric-indent-default
  104.   "*Non-nil means `simula-indent-line' function may reindent previous line.")
  105.  
  106. (defconst simula-abbrev-keyword-default 'upcase
  107.   "Specify how to convert case for SIMULA keywords.
  108. Value is one of the symbols `upcase', `downcase', `capitalize',
  109. (as in) `abbrev-table' or nil if they should not be changed.")
  110.  
  111. (defvar simula-abbrev-keyword simula-abbrev-keyword-default
  112.   "*Specify how to convert case for SIMULA keywords.
  113. Value is one of the symbols `upcase', `downcase', `capitalize',
  114. (as in) `abbrev-table' or nil if they should not be changed.")
  115.  
  116. (defconst simula-abbrev-stdproc-default 'abbrev-table
  117.   "Specify how to convert case for standard SIMULA procedure and class names.
  118. Value is one of the symbols `upcase', `downcase', `capitalize',
  119. (as in) `abbrev-table', or nil if they should not be changed.")
  120.  
  121. (defvar simula-abbrev-stdproc simula-abbrev-stdproc-default
  122.   "*Specify how to convert case for standard SIMULA procedure and class names.
  123. Value is one of the symbols `upcase', `downcase', `capitalize',
  124. (as in) `abbrev-table', or nil if they should not be changed.")
  125.  
  126. (defvar simula-abbrev-file nil
  127.   "*File with extra abbrev definitions for use in SIMULA mode.
  128. These are used together with the standard abbrev definitions for SIMULA.
  129. Please note that the standard definitions are required
  130. for SIMULA mode to function correctly.")
  131.  
  132. (defvar simula-mode-syntax-table nil
  133.   "Syntax table in SIMULA mode buffers.")
  134.  
  135. ; The following function is taken from cc-mode.el,
  136. ; it determines the flavor of the Emacs running
  137. (defconst simula-emacs-features
  138.   (let ((major (and (boundp 'emacs-major-version)
  139.             emacs-major-version))
  140.     (minor (and (boundp 'emacs-minor-version)
  141.             emacs-minor-version))
  142.     flavor comments)
  143.     ;; figure out version numbers if not already discovered
  144.     (and (or (not major) (not minor))
  145.      (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version)
  146.      (setq major (string-to-int (substring emacs-version
  147.                            (match-beginning 1)
  148.                            (match-end 1)))
  149.            minor (string-to-int (substring emacs-version
  150.                            (match-beginning 2)
  151.                            (match-end 2)))))
  152.     (if (not (and major minor))
  153.     (error "Cannot figure out the major and minor version numbers."))
  154.     ;; calculate the major version
  155.     (cond
  156.      ((= major 18) (setq major 'v18))    ;Emacs 18
  157.      ((= major 4)  (setq major 'v18))    ;Epoch 4
  158.      ((= major 19) (setq major 'v19    ;Emacs 19
  159.              flavor (if (string-match "Lucid" emacs-version)
  160.                     'Lucid 'FSF)))
  161.      ;; I don't know
  162.      (t (error "Cannot recognize major version number: %s" major)))
  163.         (list major flavor comments))
  164.   "A list of features extant in the Emacs you are using.
  165. There are many flavors of Emacs out there, each with different
  166. features supporting those needed by simula-mode.  Here's the current
  167. supported list, along with the values for this variable:
  168.  
  169.  Emacs 19:                  (v19 FSF 1-bit)
  170.  Vanilla Emacs 18/Epoch 4:  (v18 no-dual-comments)
  171.  Emacs 18/Epoch 4 (patch2): (v18 8-bit)
  172.  Lucid Emacs 19:            (v19 Lucid 8-bit).")
  173.  
  174. (defvar simula-mode-menu
  175.   '(["Report Bug"          simula-submit-bug-report t]
  176.     ["Indent Line"          simula-indent-line t]
  177.     ["Backward Statement"     simula-previous-statement t]
  178.     ["Forward Statement"      simula-next-statement t]
  179.     ["Backward Up Level"      simula-backward-up-level t]
  180.     ["Forward Down Statement" simula-forward-down-level t]
  181.     )
  182.   "Lucid Emacs menu for SIMULA mode.")
  183.  
  184. (if simula-mode-syntax-table
  185.     ()
  186.   (setq simula-mode-syntax-table (copy-syntax-table (standard-syntax-table)))
  187.   (modify-syntax-entry ?!  "<"    simula-mode-syntax-table)
  188.   (modify-syntax-entry ?$  "."    simula-mode-syntax-table)
  189.   (modify-syntax-entry ?%  "."    simula-mode-syntax-table)
  190.   (modify-syntax-entry ?'  "\""   simula-mode-syntax-table)
  191.   (modify-syntax-entry ?\( "()"   simula-mode-syntax-table)
  192.   (modify-syntax-entry ?\) ")("   simula-mode-syntax-table)
  193.   (modify-syntax-entry ?\; ">"    simula-mode-syntax-table)
  194.   (modify-syntax-entry ?\[ "."    simula-mode-syntax-table)
  195.   (modify-syntax-entry ?\\ "."    simula-mode-syntax-table)
  196.   (modify-syntax-entry ?\] "."    simula-mode-syntax-table)
  197.   (modify-syntax-entry ?_  "w"    simula-mode-syntax-table)
  198.   (modify-syntax-entry ?\| "."    simula-mode-syntax-table)
  199.   (modify-syntax-entry ?\{ "."    simula-mode-syntax-table)
  200.   (modify-syntax-entry ?\} "."    simula-mode-syntax-table))
  201.  
  202. (defvar simula-mode-map ()
  203.   "Keymap used in SIMULA mode.")
  204.  
  205. (if simula-mode-map
  206.     ()
  207.   (setq simula-mode-map (make-sparse-keymap))
  208.   (define-key simula-mode-map "\C-c\C-u"   'simula-backward-up-level)
  209.   (define-key simula-mode-map "\C-c\C-p"   'simula-previous-statement)
  210.   (define-key simula-mode-map "\C-c\C-d"   'simula-forward-down-level)
  211.   (define-key simula-mode-map "\C-c\C-n"   'simula-next-statement)
  212.   ;(define-key simula-mode-map "\C-c\C-g"   'simula-goto-definition)
  213.   ;(define-key simula-mode-map "\C-c\C-h"   'simula-standard-help)
  214.   (define-key simula-mode-map "\177"       'backward-delete-char-untabify)
  215.   (define-key simula-mode-map ":"          'simula-electric-label)
  216.   (define-key simula-mode-map "\e\C-q"     'simula-indent-exp)
  217.   (define-key simula-mode-map "\t"         'simula-indent-command)
  218.   ;; Emacs 19 defines menus in the mode map
  219.   (if (memq 'FSF simula-emacs-features)
  220.       (progn
  221.     (define-key simula-mode-map [menu-bar] (make-sparse-keymap))
  222.  
  223.     (define-key simula-mode-map [menu-bar simula]
  224.       (cons "SIMULA" (make-sparse-keymap "SIMULA")))
  225.     (define-key simula-mode-map [menu-bar simula bug-report]
  226.       '("Submit Bug Report" . simula-submit-bug-report))
  227.     (define-key simula-mode-map [menu-bar simula separator-indent]
  228.       '("--"))
  229.     (define-key simula-mode-map [menu-bar simula indent-exp]
  230.       '("Indent Expression" . simula-indent-exp))
  231.     (define-key simula-mode-map [menu-bar simula indent-line]
  232.       '("Indent Line" . simula-indent-command))
  233.     (define-key simula-mode-map [menu-bar simula separator-navigate]
  234.       '("--"))
  235.     (define-key simula-mode-map [menu-bar simula backward-stmt]
  236.       '("Previous Statement" . simula-previous-statement))
  237.     (define-key simula-mode-map [menu-bar simula forward-stmt]
  238.       '("Next Statement" . simula-next-statement))
  239.     (define-key simula-mode-map [menu-bar simula backward-up]
  240.       '("Backward Up Level" . simula-backward-up-level))
  241.     (define-key simula-mode-map [menu-bar simula forward-down]
  242.       '("Forward Down Statement" . simula-forward-down-level))
  243.  
  244.     (put 'simula-next-statement 'menu-enable '(not (eobp)))
  245.     (put 'simula-previous-statement 'menu-enable '(not (bobp)))
  246.     (put 'simula-forward-down-level 'menu-enable '(not (eobp)))
  247.     (put 'simula-backward-up-level 'menu-enable '(not (bobp)))
  248.     (put 'simula-indent-command 'menu-enable '(not buffer-read-only))
  249.     (put 'simula-indent-exp 'menu-enable '(not buffer-read-only))))
  250.  
  251.   ;; RMS: mouse-3 should not select this menu.  mouse-3's global
  252.   ;; definition is useful in SIMULA mode and we should not interfere
  253.   ;; with that.  The menu is mainly for beginners, and for them,
  254.   ;; the menubar requires less memory than a special click.
  255.   ;; in Lucid Emacs, we want the menu to popup when the 3rd button is
  256.   ;; hit.  In 19.10 and beyond this is done automatically if we put
  257.   ;; the menu on mode-popup-menu variable, see c-common-init [cc-mode.el]
  258.   (if (memq 'Lucid simula-emacs-features)
  259.       (if (not (boundp 'mode-popup-menu))
  260.       (define-key simula-mode-map 'button3 'simula-popup-menu))))
  261.  
  262. ;; menus for Lucid
  263. (defun simula-popup-menu (e)
  264.   "Pops up the SIMULA menu."
  265.   (interactive "@e")
  266.   (popup-menu (cons (concat mode-name " Mode Commands") simula-mode-menu))
  267.   (simula-keep-region-active))
  268.  
  269. ;; active regions, and auto-newline/hungry delete key
  270. (defun simula-keep-region-active ()
  271.   ;; do whatever is necessary to keep the region active in
  272.   ;; Lucid. ignore byte-compiler warnings you might see
  273.   (and (boundp 'zmacs-region-stays)
  274.        (setq zmacs-region-stays t)))
  275.  
  276. (defvar simula-mode-abbrev-table nil
  277.   "Abbrev table in SIMULA mode buffers")
  278.  
  279.  
  280. (defun simula-mode ()
  281.   "Major mode for editing SIMULA code.
  282. \\{simula-mode-map}
  283. Variables controlling indentation style:
  284.  simula-tab-always-indent
  285.     Non-nil means TAB in SIMULA mode should always reindent the current line,
  286.     regardless of where in the line point is when the TAB command is used.
  287.  simula-indent-level
  288.     Indentation of SIMULA statements with respect to containing block.
  289.  simula-substatement-offset
  290.     Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.
  291.  simula-continued-statement-offset 3
  292.     Extra indentation for lines not starting a statement or substatement,
  293.     e.g. a nested FOR-loop.  If value is a list, each line in a multiple-
  294.     line continued statement will have the car of the list extra indentation
  295.     with respect to the previous line of the statement.
  296.  simula-label-offset -4711
  297.     Offset of SIMULA label lines relative to usual indentation.
  298.  simula-if-indent '(0 . 0)
  299.     Extra indentation of THEN and ELSE with respect to the starting IF.
  300.     Value is a cons cell, the car is extra THEN indentation and the cdr
  301.     extra ELSE indentation.  IF after ELSE is indented as the starting IF.
  302.  simula-inspect-indent '(0 . 0)
  303.     Extra indentation of WHEN and OTHERWISE with respect to the
  304.     corresponding INSPECT.  Value is a cons cell, the car is
  305.     extra WHEN indentation and the cdr extra OTHERWISE indentation.
  306.  simula-electric-indent nil
  307.     If this variable is non-nil, `simula-indent-line'
  308.     will check the previous line to see if it has to be reindented.
  309.  simula-abbrev-keyword 'upcase
  310.     Determine how SIMULA keywords will be expanded.  Value is one of
  311.     the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table',
  312.     or nil if they should not be changed.
  313.  simula-abbrev-stdproc 'abbrev-table
  314.     Determine how standard SIMULA procedure and class names will be
  315.     expanded.  Value is one of the symbols `upcase', `downcase', `capitalize',
  316.     (as in) `abbrev-table', or nil if they should not be changed.
  317.  
  318. Turning on SIMULA mode calls the value of the variable simula-mode-hook
  319. with no arguments, if that value is non-nil
  320.  
  321. Warning: simula-mode-hook should not read in an abbrev file without calling
  322. the function simula-install-standard-abbrevs afterwards, preferably not
  323. at all."
  324.   (interactive)
  325.   (kill-all-local-variables)
  326.   (use-local-map simula-mode-map)
  327.   (setq major-mode 'simula-mode)
  328.   (setq mode-name "SIMULA")
  329.   (make-local-variable 'comment-column)
  330.   (setq comment-column 40)
  331. ;  (make-local-variable 'end-comment-column)
  332. ;  (setq end-comment-column 75)
  333.   (set-syntax-table simula-mode-syntax-table)
  334.   (make-local-variable 'paragraph-start)
  335.   (setq paragraph-start "[ \t]*$\\|\\f")
  336.   (make-local-variable 'paragraph-separate)
  337.   (setq paragraph-separate paragraph-start)
  338.   (make-local-variable 'indent-line-function)
  339.   (setq indent-line-function 'simula-indent-line)
  340.   (make-local-variable 'require-final-newline)
  341.   (setq require-final-newline t)
  342.   (make-local-variable 'comment-start)
  343.   (setq comment-start "! ")
  344.   (make-local-variable 'comment-end)
  345.   (setq comment-end " ;")
  346.   (make-local-variable 'comment-start-skip)
  347.   (setq comment-start-skip "!+ *")
  348.   (make-local-variable 'parse-sexp-ignore-comments)
  349.   (setq parse-sexp-ignore-comments nil)
  350.   (make-local-variable 'comment-multi-line)
  351.   (setq comment-multi-line t)
  352.   (if simula-mode-abbrev-table
  353.       ()
  354.     (if simula-abbrev-file
  355.     (read-abbrev-file simula-abbrev-file)
  356.       (define-abbrev-table 'simula-mode-abbrev-table ()))
  357.     (let (abbrevs-changed)
  358.       (simula-install-standard-abbrevs)))
  359.   (setq local-abbrev-table simula-mode-abbrev-table)
  360.   (abbrev-mode 1)
  361.   (run-hooks 'simula-mode-hook))
  362.  
  363.  
  364. (defun simula-indent-exp ()
  365.   "Indent SIMULA expression following point."
  366.   (interactive)
  367.   (let ((here (point))
  368.     (simula-electric-indent nil)
  369.     end)
  370.     (simula-skip-comment-forward)
  371.     (if (eobp)
  372.     (goto-char here)
  373.       (unwind-protect
  374.       (progn
  375.         (simula-next-statement 1)
  376.         (setq end (point-marker))
  377.         (simula-previous-statement 1)
  378.         (beginning-of-line)
  379.         (while (< (point) end)
  380.           (if (not (looking-at "[ \t]*$"))
  381.           (simula-indent-line))
  382.           (forward-line 1)))
  383.     (and end (set-marker end nil))))))
  384.       
  385.  
  386. (defun simula-indent-line ()
  387.   "Indent this line as SIMULA code.
  388. If `simula-electric-indent' is non-nil, indent previous line if necessary."
  389.   (let ((origin (- (point-max) (point)))
  390.     (indent (simula-calculate-indent))
  391.     (case-fold-search t))
  392.     (unwind-protect
  393.     (if simula-electric-indent
  394.         (progn
  395.           ;;
  396.           ;; manually expand abbrev on last line, if any
  397.           ;;
  398.           (end-of-line 0)
  399.           (expand-abbrev)
  400.           ;; now maybe we should reindent that line
  401.           (beginning-of-line)
  402.           (skip-chars-forward " \t\f")
  403.           (if (and
  404.            (looking-at
  405.             "\\(end\\|if\\|then\\|else\\|when\\|otherwise\\)\\>")
  406.            (not (simula-context)))
  407.           ;; yes - reindent
  408.           (let ((post-indent (simula-calculate-indent)))
  409.             (if (eq (current-indentation) post-indent)
  410.             ()
  411.               (delete-horizontal-space)
  412.               (indent-to post-indent))))))
  413.       (goto-char (- (point-max) origin))
  414.       (if (eq (current-indentation) indent)
  415.       (back-to-indentation)
  416.     (delete-horizontal-space)
  417.     (indent-to indent)))))
  418.  
  419.  
  420. (defun simula-indent-command (&optional whole-exp)
  421.   "Indent current line as SIMULA code, or insert TAB character.
  422. If `simula-tab-always-indent' is non-nil, always indent current line.
  423. Otherwise, indent only if point is before any non-whitespace
  424. character on the line.
  425.  
  426. A numeric argument, regardless of its value, means indent rigidly
  427. all the lines of the SIMULA statement after point so that this line
  428. becomes properly indented.
  429. The relative indentation among the lines of the statement are preserved."
  430.   (interactive "P")
  431.   (let ((case-fold-search t))
  432.     (if (or whole-exp simula-tab-always-indent
  433.         (save-excursion
  434.           (skip-chars-backward " \t\f")
  435.           (bolp)))
  436.     ;; reindent current line
  437.     (let ((indent (save-excursion
  438.             (beginning-of-line)
  439.             (simula-calculate-indent)))
  440.           (current (current-indentation))
  441.           (origin (- (point-max) (point)))
  442.           (bol (save-excursion
  443.              (skip-chars-backward " \t\f")
  444.              (bolp)))
  445.           beg end)
  446.       (unwind-protect
  447.           (if (eq current indent)
  448.           (if (save-excursion
  449.             (skip-chars-backward " \t\f")
  450.             (bolp))
  451.               (back-to-indentation))
  452.         (beginning-of-line)
  453.         (delete-horizontal-space)
  454.         (indent-to indent))
  455.         (if (not bol)
  456.         (goto-char (- (point-max) origin))))
  457.       (setq origin (point))
  458.       (if whole-exp
  459.           (save-excursion
  460.         (beginning-of-line 2)
  461.         (setq beg (point))
  462.         (goto-char origin)
  463.         (simula-next-statement 1)
  464.         (setq end (point))
  465.         (if (and (> end beg) (not (eq indent current)))
  466.             (indent-code-rigidly beg end (- indent current) "%")))))
  467.       (insert-tab))))
  468.  
  469.  
  470. (defun simula-context ()
  471.   "Returns value according to syntactic SIMULA context of point.
  472.     0    point inside COMMENT comment
  473.     1    point on SIMULA-compiler directive line
  474.     2    point inside END comment
  475.     3    point inside string
  476.     4    point inside character constant
  477.   nil    otherwise."
  478.   ;; first, find out if this is a compiler directive line
  479.   (if (save-excursion
  480.     (beginning-of-line)
  481.     (eq (following-char) ?%))
  482.       ;; YES - return 1
  483.       1
  484.     (save-excursion
  485.       ;; The current line is NOT a compiler directive line.
  486.       ;; Now, the strategy is to search backward to find a semicolon
  487.       ;; that is NOT inside a string. The point after semicolon MUST be
  488.       ;; outside a comment, since semicolons are comment-ending and
  489.       ;; comments are non-recursive. We take advantage of the fact
  490.       ;; that strings MUST end on the same line as they started, so
  491.       ;; that we can easily decide whether we are inside a string or not.
  492.       (let (return-value (origin (point)))
  493.     (skip-chars-backward "^;" (point-min))
  494.     ;; found semicolon or beginning of buffer
  495.     (let (loopvalue (saved-point origin))
  496.       (while (and (not (bobp))
  497.               (if (progn
  498.                 (beginning-of-line)
  499.                 ;; compiler directive line? If so, cont searching..
  500.                 (eq (following-char) ?%))
  501.               t
  502.             (while (< (point) saved-point)
  503.               (skip-chars-forward "^;\"'")
  504.               (forward-char 1)
  505.               (cond
  506.                ((eq (preceding-char) ?\;)
  507.                 (setq saved-point (point)))
  508.                ((eq (preceding-char) ?\")
  509.                 (skip-chars-forward "^\";")
  510.                 (if (eq (following-char) ?\;)
  511.                 (setq saved-point (point) loopvalue t)
  512.                   (forward-char 1)))
  513.                (t
  514.                 (if (eq (following-char) ?')
  515.                 (forward-char 1))
  516.                 (skip-chars-forward "^';")
  517.                 (if (eq (following-char) ?\;)
  518.                 (setq saved-point (point) loopvalue t)
  519.                   (forward-char 1)))))
  520.             loopvalue))
  521.         (backward-char 1)
  522.         (skip-chars-backward "^;")
  523.         (setq saved-point (point) loopvalue nil)))
  524.     ;; Now we are CERTAIN that we are outside comments and strings.
  525.     ;; The job now is to search forward again towards the origin
  526.     ;; skipping directives, comments and strings correctly,
  527.     ;; so that we know what context we are in when we find the origin.
  528.     (while (and
  529.         (< (point) origin)
  530.         (re-search-forward
  531.          "\\<end\\>\\|!\\|\"\\|'\\|^%\\|\\<comment\\>" origin 'move))
  532.       (cond
  533.        ((memq (preceding-char) '(?d ?D))
  534.         (setq return-value 2)
  535.         (while (and (re-search-forward
  536.              ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>\\|^%"
  537.              origin 'move)
  538.             ;; found another END?
  539.             (or (memq (preceding-char) '(?d ?D))
  540.                 ;; if directive, skip line
  541.                 (and (eq (preceding-char) ?%)
  542.                  (beginning-of-line 2))
  543.                 ;; found other keyword, out of END comment
  544.                 (setq return-value nil))))
  545.         (if (and (eq (char-syntax (preceding-char)) ?w)
  546.              (eq (char-syntax (following-char)) ?w))
  547.         (save-excursion
  548.           (backward-word 1)
  549.           (if (looking-at "end\\>\\|else\\>\\|otherwise\\>\\|when\\>")
  550.               (setq return-value nil)))))
  551.        ((memq (preceding-char) '(?! ?t ?T))
  552.         ; skip comment
  553.         (setq return-value 0)
  554.         (skip-chars-forward "^%;" origin)
  555.         (while (and return-value (< (point) origin))
  556.           (if (eq (following-char) ?\;)
  557.           (setq return-value nil)
  558.         (if (bolp)
  559.             (beginning-of-line 2)    ; skip directive inside comment
  560.           (forward-char 1))        ; or single '%'
  561.         (skip-chars-forward "^%;" origin))))
  562.        ((eq (preceding-char) ?\")
  563.         (if (not (search-forward "\"" origin 'move))
  564.         (setq return-value 3)))
  565.        ((eq (preceding-char) ?\')
  566.         (if (or (eq (point) origin) (eobp))
  567.         (setq return-value 4)
  568.           (forward-char 1)
  569.           (if (not (search-forward "'" origin 'move))
  570.           (setq return-value 4))))
  571.        ;; compiler directive line - skip
  572.        (t (beginning-of-line 2))))
  573.     return-value)
  574.       )))
  575.  
  576.  
  577. (defun simula-electric-label ()
  578.   "If this is a label that starts the line, reindent the line."
  579.   (interactive)
  580.   (expand-abbrev)
  581.   (insert ?:)
  582.   (let ((origin (- (point-max) (point)))
  583.     (case-fold-search t)
  584.     ;; don't mix a label with an assignment operator := :-
  585.     ;; therefore take a peek at next typed character...
  586.     (next-char (read-event)))
  587.     (unwind-protect
  588.     (setq unread-command-events (append unread-command-events
  589.                         (list next-char)))
  590.     ;; Problem: find out if character just read is a command char
  591.     ;; that would insert something after ':' making it a label.
  592.     ;; At least \n, \r (and maybe \t) falls into this category.
  593.     ;; This is a real crock, it depends on traditional keymap
  594.     ;; bindings, that is, printing characters doing self-insert,
  595.     ;; and no other command sequence inserting '-' or '='.
  596.     ;; simula-electric-label can be easily fooled...
  597.     (if (and (not (memq next-char '(?= ?-)))
  598.          (or (memq next-char '(?\n ?\r))
  599.              (and (eq next-char ?\t)
  600.               simula-tab-always-indent)
  601.              (not (memq (following-char) '(?= ?-))))
  602.          (not (simula-context))
  603.          ;; label?
  604.          (progn
  605.            (backward-char 1)
  606.            (skip-chars-backward " \t\f")
  607.            (skip-chars-backward "a-zA-Z0-9_")
  608.            (if (looking-at "virtual\\>")
  609.                nil
  610.              (skip-chars-backward " \t\f")
  611.              (bolp))))
  612.         (let ((amount (simula-calculate-indent)))
  613.           (delete-horizontal-space)
  614.           (indent-to amount)))
  615.       (goto-char (- (point-max) origin)))))
  616.     
  617.  
  618. (defun simula-backward-up-level (count)
  619.   "Move backward up COUNT block levels.
  620. If COUNT is negative, move forward up block level instead."
  621.   (interactive "p")
  622.   (let ((origin (point))
  623.     (case-fold-search t))
  624.     (condition-case ()
  625.     (if (> count 0)
  626.         (while (> count 0)
  627.           (re-search-backward "\\<begin\\>\\|\\<end\\>")
  628.           (if (not (simula-context))
  629.           (setq count (if (memq (following-char) '(?b ?B))
  630.                   (1- count)
  631.                 (1+ count)))))
  632.       (while (< count 0)
  633.         (re-search-forward "\\<begin\\>\\|\\<end\\>")
  634.         (backward-word 1)
  635.         (if (not (simula-context))
  636.         (setq count (if (memq (following-char) '(?e ?E))
  637.                 (1+ count)
  638.                   (1- count))))
  639.         (backward-word -1)))
  640.       ;; If block level not found, jump back to origin and signal an error
  641.       (error (progn
  642.            (goto-char origin)
  643.            (error "No higher block level")))
  644.       (quit (progn
  645.           (goto-char origin)
  646.           (signal 'quit nil))))))
  647.  
  648.  
  649. (defun simula-forward-down-level (count)
  650.   "Move forward down COUNT block levels.
  651. If COUNT is negative, move backward down block level instead."
  652.   (interactive "p")
  653.   ;; When we search for a deeper block level, we must never
  654.   ;; get out of the block where we started -> count >= start-count
  655.   (let ((start-count count)
  656.     (origin (point))
  657.     (case-fold-search t))
  658.     (condition-case ()
  659.     (if (< count 0)
  660.         (while (< count 0)
  661.           (re-search-backward "\\<begin\\>\\|\\<end\\>")
  662.           (if (not (simula-context))
  663.           (setq count (if (memq (following-char) '(?e ?E))
  664.                   (1+ count)
  665.                 (1- count))))
  666.           (if (< count start-count) (signal 'error nil)))
  667.       (while (> count 0)
  668.         (re-search-forward "\\<begin\\>\\|\\<end\\>")
  669.         (backward-word 1)
  670.         (if (not (simula-context))
  671.         (setq count (if (memq (following-char) '(?b ?B))
  672.                 (1- count)
  673.                   (1+ count))))
  674.         (backward-word -1)
  675.         ;; deeper level has to be found within starting block
  676.         (if (> count start-count) (signal 'error nil))))
  677.       ;; If block level not found, jump back to origin and signal an error
  678.       (error (progn
  679.            (goto-char origin)
  680.            (error "No containing block level")))
  681.       (quit (progn
  682.           (goto-char origin)
  683.           (signal 'quit nil))))))
  684.  
  685.      
  686. (defun simula-previous-statement (count)
  687.   "Move backward COUNT statements.
  688. If COUNT is negative, move forward instead."
  689.   (interactive "p")
  690.   (if (< count 0)
  691.       (simula-next-statement (- count))
  692.     (let (status
  693.       (case-fold-search t)
  694.       (origin (point)))
  695.       (condition-case ()
  696.       ;; 
  697.       (progn
  698.         (simula-skip-comment-backward)
  699.         (if (memq (preceding-char) '(?n ?N))
  700.         (progn
  701.           (backward-word 1)
  702.           (if (not (looking-at "\\<begin\\>"))
  703.               (backward-word -1)))
  704.           (if (eq (preceding-char) ?\;)
  705.           (backward-char 1))
  706.           )
  707.         (while (and (natnump (setq count (1- count)))
  708.             (setq status (simula-search-backward
  709.                       ";\\|\\<begin\\>" nil 'move))))
  710.         (if status
  711.         (progn
  712.           (if (eq (following-char) ?\;)
  713.               (forward-char 1)
  714.             (backward-word -1))))
  715.         (simula-skip-comment-forward))
  716.     (error (progn (goto-char origin)
  717.               (error "Incomplete statement (too many ENDs)")))
  718.     (quit (progn (goto-char origin) (signal 'quit nil)))))))
  719.  
  720.  
  721. (defun simula-next-statement (count)
  722.   "Move forward COUNT statements.
  723. If COUNT is negative, move backward instead."
  724.   (interactive "p")
  725.   (if (< count 0)
  726.       (simula-previous-statement (- count))
  727.     (let (status
  728.       (case-fold-search t)
  729.       (origin (point)))
  730.       (condition-case ()
  731.       (progn
  732.         (simula-skip-comment-forward)
  733.         (if (looking-at "\\<end\\>") (forward-word 1))
  734.         (while (and (natnump (setq count (1- count)))
  735.             (setq status (simula-search-forward
  736.                       ";\\|\\<end\\>" (point-max) 'move))))
  737.         (if (and status (/= (preceding-char) ?\;))
  738.         (progn
  739.           (backward-word 1)
  740.           (simula-skip-comment-backward))))
  741.     (error (progn (goto-char origin)
  742.               (error "Incomplete statement (too few ENDs)")))
  743.      (quit (progn (goto-char origin) (signal 'quit nil)))))))
  744.  
  745.  
  746. (defun simula-skip-comment-backward (&optional stop-at-end)
  747.   "Search towards bob to find first char that is outside a comment."
  748.   (interactive)
  749.   (catch 'simula-out
  750.     (let (context)
  751.       (while t
  752.     (skip-chars-backward " \t\n\f")
  753.     (if (eq (preceding-char) ?\;)
  754.         (save-excursion
  755.           (backward-char 1)
  756.           (setq context (simula-context))
  757.           (if (and stop-at-end (eq context 2))
  758.           (setq context nil)))
  759.       (setq context (simula-context)))
  760.     (cond
  761.      ((memq context '(nil 3 4))
  762.       ;; check to see if we found a label
  763.       (if (and (eq (preceding-char) ?:)
  764.            (not (memq (following-char) '(?- ?=)))
  765.            (save-excursion
  766.              (skip-chars-backward ": \t\fa-zA-Z0-9_")
  767.              (not (looking-at "virtual\\>"))))
  768.           (skip-chars-backward ": \t\fa-zA-Z0-9_")
  769.         (throw 'simula-out nil)))
  770.      ((eq context 0)
  771.       ;; since we are inside a comment, it must start somewhere!
  772.       (while (and (re-search-backward "!\\|\\<comment\\>")
  773.               (memq (simula-context) '(0 1)))))
  774.      ((eq context 1)
  775.       (beginning-of-line)
  776.       (if (bobp)
  777.           (throw 'simula-out nil)
  778.         (backward-char)))
  779.      ((eq context 2)
  780.       ;; an END-comment must belong to an END
  781.       (re-search-backward "\\<end\\>")
  782.       (forward-word 1)
  783.       (throw 'simula-out nil))
  784.      ;; should be impossible to get here..
  785.      )))))
  786.  
  787.  
  788. (defun simula-skip-comment-forward ()
  789.   "Search towards eob to find first char that is outside a comment."
  790.   ;; this function assumes we start with point .outside a comment
  791.   (interactive)
  792.   (catch 'simula-out
  793.     (while t
  794.       (skip-chars-forward " \t\n\f")
  795.       ;; BUG: the following (0 2) branches don't take into account intermixing
  796.       ;; directive lines
  797.       (cond
  798.        ((looking-at "!\\|\\<comment\\>")
  799.     (search-forward ";" nil 'move))
  800.        ((and (bolp) (eq (following-char) ?%))
  801.     (beginning-of-line 2))
  802.        ((and (looking-at "[a-z0-9_]*[ \t\f]*:[^-=]")
  803.          (not (looking-at "virtual\\>")))
  804.     (skip-chars-forward "a-zA-Z0-9_ \t\f:"))
  805.        (t
  806.     (throw 'simula-out t))))))
  807.  
  808.  
  809. (defun simula-forward-up-level ()
  810.   (let ((continue-loop t)
  811.     (origin (point))
  812.     (case-fold-search t)
  813.     return-value
  814.     temp)
  815.     (while continue-loop
  816.       (if (re-search-backward "\\<begin\\>\\|\\<end\\>" (point-min) 'move)
  817.       (setq temp (simula-context)
  818.           return-value (and (memq (preceding-char) '(?d ?D))
  819.                 (memq temp '(nil 2)))
  820.           continue-loop (and (not return-value)
  821.                  (simula-forward-up-level)))
  822.     (setq continue-loop nil)))
  823.     (if return-value
  824.     t
  825.       (goto-char origin)
  826.       nil)))
  827.  
  828.  
  829. (defun simula-calculate-indent ()
  830.   (save-excursion
  831.     (let ((where (simula-context))
  832.       (origin (point))
  833.       (indent 0)
  834.       continued
  835.       start-line
  836.       temp
  837.       found-end
  838.       prev-cont)
  839.       (cond
  840.        ((eq where 0)
  841.     ;;
  842.     ;; Comment.
  843.     ;; If comment started on previous non-blank line, indent to the
  844.     ;; column where the comment started, else indent as that line.
  845.     ;;
  846.     (skip-chars-backward " \t\n\f")
  847.     (while (and (not (bolp)) (eq (simula-context) 0))
  848.       (re-search-backward "^\\|!\\|\\<comment\\>"))
  849.     (skip-chars-forward " \t\n\f")
  850.     (prog1
  851.         (current-column)
  852.       (goto-char origin)))
  853.        ((eq where 1)
  854.     ;;
  855.     ;; Directive. Always 0.
  856.     ;;
  857.     0)
  858.        ;;
  859.        ;; Detect missing string delimiters
  860.        ;;
  861.        ((eq where 3)
  862.     (error "Inside string"))
  863.        ((eq where 4)
  864.     (error "Inside character constant"))
  865.        ;;
  866.        ;; check to see if inside ()'s
  867.        ;;
  868.        ((setq temp (simula-inside-parens))
  869.     temp)
  870.        ;;
  871.        ;; Calculate non-comment indentation
  872.        (t
  873.     ;; first, find out if this line starts with something that needs
  874.     ;; special indentation (END/IF/THEN/ELSE/WHEN/OTHERWISE or label)
  875.     ;;
  876.     (skip-chars-forward " \t\f")
  877.     (cond
  878.      ;;
  879.      ;; END
  880.      ;;
  881.      ((looking-at "end\\>")
  882.       (setq indent (- simula-indent-level)
  883.         found-end t))
  884.      ;;
  885.      ;; IF/THEN/ELSE
  886.      ;;
  887.      ((looking-at "if\\>\\|then\\>\\|else\\>")
  888.       ;; search for the *starting* IF
  889.       (cond
  890.        ((memq (following-char) '(?T ?t))
  891.         (setq indent (car simula-if-indent)))
  892.        ((memq (following-char) '(?E ?e))
  893.         (setq indent (cdr simula-if-indent)))
  894.        (t
  895.         (forward-word 1)
  896.         (setq indent 0)))
  897.       (simula-find-if))
  898.      ;;
  899.      ;; WHEN/OTHERWISE
  900.      ;;
  901.      ((looking-at "when\\>\\|otherwise\\>")
  902.       ;; search for corresponding INSPECT
  903.       (if (memq (following-char) '(?W ?w))
  904.           (setq indent (car simula-inspect-indent))
  905.         (setq indent (cdr simula-inspect-indent)))
  906.       (simula-find-inspect))
  907.      ;;
  908.      ;; label:
  909.      ;;
  910.      ((and (not (looking-at "virtual\\>"))
  911.            (looking-at "[a-z0-9_]*[ \t\f]*:[^-=]"))
  912.       (setq indent simula-label-offset)))
  913.     ;; find line with non-comment text
  914.     (simula-skip-comment-backward 'dont-skip-end)
  915.     (if (and found-end
  916.          (not (eq (preceding-char) ?\;))
  917.          (if (memq (preceding-char) '(?N ?n))
  918.              (save-excursion
  919.                (backward-word 1)
  920.                (not (looking-at "begin\\>")))
  921.            t))
  922.         (progn
  923.           (simula-previous-statement 1)
  924.           (simula-skip-comment-backward)))
  925.     (setq start-line
  926.           (save-excursion (beginning-of-line) (point))
  927.           ;; - perhaps this is a continued statement
  928.           continued
  929.           (save-excursion
  930.         (and (not (bobp))
  931.              ;; (not found-end)
  932.              (if (eq (char-syntax (preceding-char)) ?w)
  933.              (progn
  934.                (backward-word 1)
  935.                (not (looking-at
  936.                  "begin\\|then\\|else\\|when\\|otherwise\\|do"
  937.                  )))
  938.                (not (memq (preceding-char) '(?: ?\;)))))))
  939.     ;;
  940.     ;; MAIN calculation loop - count BEGIN/DO etc.
  941.     ;;
  942.     (while (not (bolp))
  943.       (if (re-search-backward
  944.            ";\\|\\<\\(begin\\|end\\|if\\|else\\|then\\|when\\|otherwise\\|do\\)\\>"
  945.            start-line 'move)
  946.           (if (simula-context)
  947.           ();; found something in a comment/string - ignore
  948.         (setq temp (following-char))
  949.         (cond
  950.          ((eq temp ?\;)
  951.           (simula-previous-statement 1))
  952.          ((looking-at "begin\\>")
  953.           (setq indent (+ indent simula-indent-level)))
  954.          ((looking-at "end\\>")
  955.           (forward-word 1)
  956.           (simula-previous-statement 1))
  957.          ((looking-at "do\\>")
  958.           (setq indent (+ indent simula-substatement-offset))
  959.           (simula-find-do-match))
  960.          ((looking-at "\\(if\\|then\\|else\\)\\>")
  961.           (if (memq temp '(?I ?i))
  962.               (forward-word 1)
  963.             (setq indent (+ indent
  964.                     simula-substatement-offset
  965.                     (if (memq temp '(?T ?t))
  966.                     (car simula-if-indent)
  967.                       (cdr simula-if-indent)))))
  968.           (simula-find-if))
  969.          ((looking-at "\\<when\\>\\|\\<otherwise\\>")
  970.           (setq indent (+ indent
  971.                   simula-substatement-offset
  972.                   (if (memq temp '(?W ?w))
  973.                       (car simula-if-indent)
  974.                     (cdr simula-if-indent))))
  975.           (simula-find-inspect)))
  976.         ;; found the start of a [sub]statement
  977.         ;; add indentation for continued statement
  978.         (if continued
  979.             (setq indent
  980.               (+ indent
  981.                  (if (listp simula-continued-statement-offset)
  982.                  (car simula-continued-statement-offset)
  983.                    simula-continued-statement-offset))))
  984.         (setq start-line
  985.               (save-excursion (beginning-of-line) (point))
  986.               continued nil))
  987.         ;; search failed .. point is at beginning of line
  988.         ;; determine if we should continue searching
  989.         ;; (at or before comment or label)
  990.         ;; temp = t means finished
  991.         (setq temp
  992.           (and (not (simula-context))            
  993.                (save-excursion
  994.              (skip-chars-forward " \t\f")
  995.              (or (looking-at "virtual")
  996.                  (not
  997.                   (looking-at
  998.                    "!\\|comment\\>\\|[a-z0-9_]*[ \t\f]*:[^-=]")))))
  999.           prev-cont continued)
  1000.         ;; if we are finished, find current line's indentation
  1001.         (if temp
  1002.         (setq indent (+ indent (current-indentation))))
  1003.         ;; find next line with non-comment SIMULA text
  1004.         ;; maybe indent extra if statement continues
  1005.         (simula-skip-comment-backward)
  1006.         (setq continued
  1007.           (and (not (bobp))
  1008.                (if (eq (char-syntax (preceding-char)) ?w)
  1009.                (save-excursion
  1010.                  (backward-word 1)
  1011.                  (not (looking-at
  1012.                    "begin\\|then\\|else\\|when\\|otherwise\\|do")))
  1013.              (not (memq (preceding-char) '(?: ?\;))))))
  1014.         ;; if we the state of the continued-variable
  1015.         ;; changed, add indentation for continued statement
  1016.         (if (or (and prev-cont (not continued))
  1017.             (and continued
  1018.              (listp simula-continued-statement-offset)))
  1019.         (setq indent
  1020.               (+ indent
  1021.              (if (listp simula-continued-statement-offset)
  1022.                  (car simula-continued-statement-offset)
  1023.                simula-continued-statement-offset))))
  1024.         ;; while ends if point is at beginning of line at loop test
  1025.         (if (not temp)
  1026.         (setq start-line (save-excursion (beginning-of-line) (point)))
  1027.           (beginning-of-line))))
  1028.         ;;
  1029.     ;; return indentation
  1030.     ;;
  1031.     indent)))))
  1032.  
  1033.  
  1034. (defun simula-find-if ()
  1035.   "Find starting IF of a IF-THEN[-ELSE[-IF-THEN...]] statement."
  1036.   (catch 'simula-out
  1037.     (while t
  1038.       (if (and (simula-search-backward "\\<if\\>\\|;\\|\\<begin\\>"nil t)
  1039.            (memq (following-char) '(?I ?i)))
  1040.       (save-excursion
  1041.         ;;
  1042.         ;; find out if this IF was really the start of the IF statement
  1043.         ;;
  1044.         (simula-skip-comment-backward)
  1045.         (if (and (eq (char-syntax (preceding-char)) ?w)
  1046.              (progn
  1047.                (backward-word 1)
  1048.                (looking-at "else\\>")))
  1049.         ()
  1050.           (throw 'simula-out t)))
  1051.     (if (not (looking-at "\\<if\\>"))
  1052.         (error "Missing IF or misplaced BEGIN or ';' (can't find IF)")
  1053.       ;;
  1054.       ;; we were at the starting IF in the first place..
  1055.       ;;
  1056.       (throw 'simula-out t))))))
  1057.  
  1058.  
  1059. (defun simula-find-inspect ()
  1060.   "Find INSPECT matching WHEN or OTHERWISE."
  1061.   (catch 'simula-out
  1062.     (let ((level 0))
  1063.       ;;
  1064.       ;; INSPECTs can be nested, have to find the corresponding one
  1065.       ;;
  1066.       (while t
  1067.     (if (and (simula-search-backward "\\<inspect\\>\\|\\<otherwise\\>\\|;"
  1068.                       nil t)
  1069.          (/= (following-char) ?\;))
  1070.         (if (memq (following-char) '(?O ?o))
  1071.         (setq level (1+ level))
  1072.           (if (zerop level)
  1073.           (throw 'simula-out t)
  1074.         (setq level (1- level))))
  1075.       (error "Missing INSPECT or misplaced ';' (can't find INSPECT)"))))))
  1076.  
  1077.  
  1078. (defun simula-find-do-match ()
  1079.   "Find keyword matching DO: FOR, WHILE, INSPECT or WHEN"
  1080.   (while (and (re-search-backward
  1081.            "\\<\\(do\\|for\\|while\\|inspect\\|when\\|end\\|begin\\)\\>\\|;"
  1082.            nil 'move)
  1083.           (simula-context)))
  1084.   (if (and (looking-at "\\<\\(for\\|while\\|inspect\\|when\\)\\>")
  1085.        (not (simula-context)))
  1086.       () ;; found match
  1087.     (error "No matching FOR, WHILE or INSPECT for DO, or misplaced ';'")))
  1088.  
  1089.  
  1090. (defun simula-inside-parens ()
  1091.   "Return position after `(' on line if inside parentheses, nil otherwise."
  1092.   (save-excursion
  1093.     (let ((parlevel 0))
  1094.       (catch 'simula-out
  1095.     (while t
  1096.       (if (re-search-backward "(\\|)\\|;" nil t)
  1097.           (if (eq (simula-context) nil)
  1098.           ;; found something - check it out
  1099.           (cond
  1100.            ((eq (following-char) ?\;)
  1101.             (if (zerop parlevel)
  1102.             (throw 'simula-out nil)
  1103.               (error "Parenthesis mismatch or misplaced ';'")))
  1104.            ((eq (following-char) ?\()
  1105.             (if (zerop parlevel)
  1106.             (throw 'simula-out (1+ (current-column)))
  1107.               (setq parlevel (1- parlevel))))
  1108.            (t (setq parlevel (1+ parlevel))))
  1109.         );; nothing - inside comment or string
  1110.         ;; search failed
  1111.         (throw 'simula-out nil)))))))
  1112.  
  1113.  
  1114. (defun simula-goto-definition ()
  1115.   "Goto point of definition of variable, procedure or class."
  1116.   (interactive))
  1117.  
  1118.  
  1119. (defun simula-expand-stdproc ()
  1120.   (if (or (not simula-abbrev-stdproc) (simula-context))
  1121.       (unexpand-abbrev)
  1122.     (cond
  1123.      ((eq simula-abbrev-stdproc 'upcase) (upcase-word -1))
  1124.      ((eq simula-abbrev-stdproc 'downcase) (downcase-word -1))
  1125.      ((eq simula-abbrev-stdproc 'capitalize) (capitalize-word -1))
  1126.      ((eq simula-abbrev-stdproc 'abbrev-table)
  1127.       ;; If not in lowercase, expansions are always capitalized.
  1128.       ;; We then want to replace with the exact expansion.
  1129.       (if (equal (symbol-name last-abbrev) last-abbrev-text)
  1130.       ()
  1131.     (downcase-word -1)
  1132.     (expand-abbrev))))))
  1133.  
  1134.  
  1135. (defun simula-expand-keyword ()
  1136.   (if (or (not simula-abbrev-keyword) (simula-context))
  1137.       (unexpand-abbrev)
  1138.     (cond
  1139.      ((eq simula-abbrev-keyword 'upcase) (upcase-word -1))
  1140.      ((eq simula-abbrev-keyword 'downcase) (downcase-word -1))
  1141.      ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1))
  1142.      ((eq simula-abbrev-stdproc 'abbrev-table)
  1143.       (if (equal (symbol-name last-abbrev) last-abbrev-text)
  1144.       ()
  1145.     (downcase-word -1)
  1146.     (expand-abbrev))))))
  1147.  
  1148.  
  1149. (defun simula-electric-keyword ()
  1150.   "Expand SIMULA keyword.  If it starts the line, reindent."
  1151.   ;; redisplay
  1152.   (let ((show-char (eq this-command 'self-insert-command)))
  1153.     ;; If the abbrev expansion results in reindentation, the user may have
  1154.     ;; to wait some time before the character he typed is displayed
  1155.     ;; (the char causing the expansion is inserted AFTER the hook function
  1156.     ;; is called). This is annoying in case of normal characters.
  1157.     ;; However, if the user pressed a key bound to newline, it is better
  1158.     ;; to have the line inserted after the begin-end match.
  1159.     (if show-char
  1160.     (progn
  1161.       (insert-char last-command-char 1)
  1162.       (sit-for 0)
  1163.       (backward-char 1)))
  1164.     (if (let ((where (simula-context))
  1165.           (case-fold-search t))
  1166.       (if where
  1167.           (if (and (eq where 2) (eq (char-syntax (preceding-char)) ?w))
  1168.           (save-excursion
  1169.             (backward-word 1)
  1170.             (not (looking-at "end\\>"))))))
  1171.     (unexpand-abbrev)
  1172.       (cond
  1173.        ((not simula-abbrev-keyword) (unexpand-abbrev))
  1174.        ((eq simula-abbrev-keyword 'upcase) (upcase-word -1))
  1175.        ((eq simula-abbrev-keyword 'downcase) (downcase-word -1))
  1176.        ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1)))
  1177.       (let ((pos (- (point-max) (point)))
  1178.         (case-fold-search t)
  1179.         null)
  1180.     (condition-case null
  1181.         (progn
  1182.           ;; check if the expanded word is on the beginning of the line.
  1183.           (if (and (eq (char-syntax (preceding-char)) ?w)
  1184.                (progn
  1185.              (backward-word 1)
  1186.              (if (looking-at "end\\>")
  1187.                  (save-excursion
  1188.                    (simula-backward-up-level 1)
  1189.                    (if (pos-visible-in-window-p)
  1190.                    (sit-for 1)
  1191.                  (message "Matches %s"
  1192.                       (buffer-substring
  1193.                        (point)
  1194.                        (+ (point) (window-width)))))))
  1195.              (skip-chars-backward " \t\f")
  1196.              (bolp)))
  1197.           (let ((indent (simula-calculate-indent)))
  1198.             (if (eq indent (current-indentation))
  1199.             ()
  1200.               (delete-horizontal-space)
  1201.               (indent-to indent)))
  1202.         (skip-chars-forward " \t\f"))
  1203.           ;; check for END - blow whistles and ring bells
  1204.  
  1205.           (goto-char (- (point-max) pos))
  1206.           (if show-char
  1207.           (delete-char 1)))
  1208.       (quit (goto-char (- (point-max) pos))))))))
  1209.  
  1210.  
  1211. (defun simula-search-backward (regexp &optional bound noerror)
  1212.   "Search backward from point for regular expression REGEXP, ignoring matches
  1213. found inside SIMULA comments, string literals, and BEGIN..END blocks.
  1214. Set point to the end of the occurrence found, and return point.
  1215. An optional second argument BOUND bounds the search, it is a buffer position.
  1216. The match found must not extend after that position.  Optional third argument
  1217. NOERROR, if t, means if fail just return nil (no error).
  1218. If not nil and not t, move to limit of search and return nil."
  1219.   (let (begin end context (comb-regexp (concat regexp "\\|\\<end\\>"))
  1220.           match (start-point (point)))
  1221.     (catch 'simula-backward
  1222.       (while (re-search-backward comb-regexp bound 1)
  1223.     ;; We have a match, check SIMULA context at match-beginning
  1224.     ;; to see if we are outside comments etc.
  1225.     ;; Set MATCH to t if we found a true match,
  1226.     ;; set MATCH to 'BLOCK if we found a BEGIN..END block,
  1227.     ;; else set MATCH to nil.
  1228.     (save-match-data
  1229.       (setq context (simula-context))
  1230.       (cond
  1231.        ((eq context nil)
  1232.         (setq match (if (looking-at regexp) t 'BLOCK)))
  1233. ;;; A comment-ending semicolon is part of the comment, and shouldn't match.
  1234. ;;;         ((eq context 0)
  1235. ;;;          (setq match (if (eq (following-char) ?\;) t nil)))
  1236.        ((eq context 2)
  1237.         (setq match (if (and (looking-at regexp)
  1238.                  (looking-at ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>"))
  1239.                 t
  1240.               (if (looking-at "\\<end\\>") 'BLOCK nil))))
  1241.        (t (setq match nil))))
  1242.     ;; Exit if true match
  1243.     (if (eq match t) (throw 'simula-backward (point)))
  1244.     (if (eq match 'BLOCK)
  1245.     ;; We found the END of a block
  1246.         (let ((level 0))
  1247.           (while (natnump level)
  1248.           (if (re-search-backward "\\<begin\\>\\|\\<end\\>" bound 1)
  1249.               (let ((context (simula-context)))
  1250.             ;;    We found a BEGIN -> decrease level count
  1251.             (cond ((and (eq context nil)
  1252.                    (memq (following-char) '(?b ?B)))
  1253.                    (setq level (1- level)))
  1254.                   ;; END -> increase level count
  1255.                   ((and (memq context '(nil 2))
  1256.                     (memq (following-char) '(?e ?E)))
  1257.                    (setq level (1+ level)))))
  1258.             ;; Block search failed.  Action depends on noerror.
  1259.             (if (or (not noerror) (eq noerror t))
  1260.             (goto-char start-point))
  1261.             (if (not noerror)
  1262.             (signal 'search-failed (list regexp)))
  1263.             (throw 'simula-backward nil))))))
  1264.       ;; Search failed.  Action depends on noerror.
  1265.       (if (or (not noerror) (eq noerror t))
  1266.       (goto-char start-point))
  1267.       (if noerror
  1268.       nil
  1269.     (signal 'search-failed (list regexp))))))
  1270.  
  1271.  
  1272. (defun simula-search-forward (regexp &optional bound noerror)
  1273.   "Search forward from point for regular expression REGEXP, ignoring matches
  1274. found inside SIMULA comments, string literals, and BEGIN..END blocks.
  1275. Set point to the end of the occurrence found, and return point.
  1276. An optional second argument BOUND bounds the search, it is a buffer position.
  1277. The match found must not extend after that position.  Optional third argument
  1278. NOERROR, if t, means if fail just return nil (no error).
  1279. If not nil and not t, move to limit of search and return nil."
  1280.   (let (begin end context (comb-regexp (concat regexp "\\|\\<begin\\>"))
  1281.           match (start-point (point)))
  1282.     (catch 'simula-forward
  1283.       (while (re-search-forward comb-regexp bound 1)
  1284.     ;; We have a match, check SIMULA context at match-beginning
  1285.     ;; to see if we are outside comments.
  1286.     ;; Set MATCH to t if we found a true match,
  1287.     ;; set MATCH to 'BLOCK if we found a BEGIN..END block,
  1288.     ;; else set MATCH to nil.
  1289.     (save-match-data
  1290.       (save-excursion
  1291.         (goto-char (match-beginning 0))
  1292.         (setq context (simula-context))
  1293.         (cond
  1294.          ((not context)
  1295.           (setq match (if (looking-at regexp) t 'BLOCK)))
  1296. ;;; A comment-ending semicolon is part of the comment, and shouldn't match.
  1297. ;;;         ((eq context 0)
  1298. ;;;          (setq match (if (eq (following-char) ?\;) t nil)))
  1299.          ((eq context 2)
  1300.           (setq match (if (and (looking-at regexp)
  1301.                    (looking-at ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>")) t nil)))
  1302.          (t (setq match nil)))))
  1303.     ;; Exit if true match
  1304.     (if (eq match t) (throw 'simula-forward (point)))
  1305.     (if (eq match 'BLOCK)
  1306.     ;; We found the BEGINning of a block
  1307.         (let ((level 0))
  1308.           (while (natnump level)
  1309.           (if (re-search-forward "\\<begin\\>\\|\\<end\\>" bound 1)
  1310.               (let ((context (simula-context)))
  1311.             ;;    We found a BEGIN -> increase level count
  1312.             (cond ((eq context nil) (setq level (1+ level)))
  1313.                   ;; END -> decrease level count
  1314.                   ((and (eq context 2)
  1315.                     ;; Don't match BEGIN inside END comment
  1316.                     (memq (preceding-char) '(?d ?D)))
  1317.                    (setq level (1- level)))))
  1318.             ;; Block search failed.  Action depends on noerror.
  1319.             (if (or (not noerror) (eq noerror t))
  1320.             (goto-char start-point))
  1321.             (if (not noerror)
  1322.             (signal 'search-failed (list regexp)))
  1323.             (throw 'simula-forward nil))))))
  1324.       ;; Search failed.  Action depends on noerror.
  1325.       (if (or (not noerror) (eq noerror t))
  1326.       (goto-char start-point))
  1327.       (if noerror
  1328.       nil
  1329.     (signal 'search-failed (list regexp))))))
  1330.  
  1331.   
  1332. (defun simula-install-standard-abbrevs ()
  1333.   "Define Simula keywords, procedures and classes in local abbrev table."
  1334.   ;; procedure and class names are as of the SIMULA 87 standard.
  1335.   (interactive)
  1336.   (mapcar (function (lambda (args)
  1337.               (apply 'define-abbrev simula-mode-abbrev-table args)))
  1338.       '(("abs" "Abs" simula-expand-stdproc)
  1339.         ("accum" "Accum" simula-expand-stdproc)
  1340.         ("activate" "ACTIVATE" simula-expand-keyword)
  1341.         ("addepsilon" "AddEpsilon" simula-expand-stdproc)
  1342.         ("after" "AFTER" simula-expand-keyword)
  1343.         ("and" "AND" simula-expand-keyword)
  1344.         ("arccos" "ArcCos" simula-expand-stdproc)
  1345.         ("arcsin" "ArcSin" simula-expand-stdproc)
  1346.         ("arctan" "ArcTan" simula-expand-stdproc)
  1347.         ("arctan2" "ArcTan2" simula-expand-stdproc)
  1348.         ("array" "ARRAY" simula-expand-keyword)
  1349.         ("at" "AT" simula-expand-keyword)
  1350.         ("before" "BEFORE" simula-expand-keyword)
  1351.         ("begin" "BEGIN" simula-expand-keyword)
  1352.         ("blanks" "Blanks" simula-expand-stdproc)
  1353.         ("boolean" "BOOLEAN" simula-expand-keyword)
  1354.         ("breakoutimage" "BreakOutImage" simula-expand-stdproc)
  1355.         ("bytefile" "ByteFile" simula-expand-stdproc)
  1356.         ("call" "Call" simula-expand-stdproc)
  1357.         ("cancel" "Cancel" simula-expand-stdproc)
  1358.         ("cardinal" "Cardinal" simula-expand-stdproc)
  1359.         ("char" "Char" simula-expand-stdproc)
  1360.         ("character" "CHARACTER" simula-expand-keyword)
  1361.         ("checkpoint" "CheckPoint" simula-expand-stdproc)
  1362.         ("class" "CLASS" simula-expand-keyword)
  1363.         ("clear" "Clear" simula-expand-stdproc)
  1364.         ("clocktime" "ClockTime" simula-expand-stdproc)
  1365.         ("close" "Close" simula-expand-stdproc)
  1366.         ("comment" "COMMENT" simula-expand-keyword)
  1367.         ("constant" "Constant" simula-expand-stdproc)
  1368.         ("copy" "Copy" simula-expand-stdproc)
  1369.         ("cos" "Cos" simula-expand-stdproc)
  1370.         ("cosh" "CosH" simula-expand-stdproc)
  1371.         ("cotan" "CoTan" simula-expand-stdproc)
  1372.         ("cputime" "CpuTime" simula-expand-stdproc)
  1373.         ("current" "Current" simula-expand-stdproc)
  1374.         ("datetime" "DateTime" simula-expand-stdproc)
  1375.         ("decimalmark" "DecimalMark" simula-expand-stdproc)
  1376.         ("delay" "DELAY" simula-expand-keyword)
  1377.         ("deleteimage" "DeleteImage" simula-expand-stdproc)
  1378.         ("detach" "Detach" simula-expand-stdproc)
  1379.         ("digit" "Digit" simula-expand-stdproc)
  1380.         ("directbytefile" "DirectByteFile" simula-expand-stdproc)
  1381.         ("directfile" "DirectFile" simula-expand-stdproc)
  1382.         ("discrete" "Discrete" simula-expand-stdproc)
  1383.         ("do" "DO" simula-expand-keyword)
  1384.         ("downcase" "Downcase" simula-expand-stdproc)
  1385.         ("draw" "Draw" simula-expand-stdproc)
  1386.         ("eject" "Eject" simula-expand-stdproc)
  1387.         ("else" "ELSE" simula-electric-keyword)
  1388.         ("empty" "Empty" simula-expand-stdproc)
  1389.         ("end" "END" simula-electric-keyword)
  1390.         ("endfile" "Endfile" simula-expand-stdproc)
  1391.         ("entier" "Entier" simula-expand-stdproc)
  1392.         ("eq" "EQ" simula-expand-keyword)
  1393.         ("eqv" "EQV" simula-expand-keyword)
  1394.         ("erlang" "Erlang" simula-expand-stdproc)
  1395.         ("error" "Error" simula-expand-stdproc)
  1396.         ("evtime" "EvTime" simula-expand-stdproc)
  1397.         ("exp" "Exp" simula-expand-stdproc)
  1398.         ("external" "EXTERNAL" simula-expand-keyword)
  1399.         ("false" "FALSE" simula-expand-keyword)
  1400.         ("field" "Field" simula-expand-stdproc)
  1401.         ("file" "File" simula-expand-stdproc)
  1402.         ("first" "First" simula-expand-stdproc)
  1403.         ("follow" "Follow" simula-expand-stdproc)
  1404.         ("for" "FOR" simula-expand-keyword)
  1405.         ("ge" "GE" simula-expand-keyword)
  1406.         ("getchar" "GetChar" simula-expand-stdproc)
  1407.         ("getfrac" "GetFrac" simula-expand-stdproc)
  1408.         ("getint" "GetInt" simula-expand-stdproc)
  1409.         ("getreal" "GetReal" simula-expand-stdproc)
  1410.         ("go" "GO" simula-expand-keyword)
  1411.         ("goto" "GOTO" simula-expand-keyword)
  1412.         ("gt" "GT" simula-expand-keyword)
  1413.         ("head" "Head" simula-expand-stdproc)
  1414.         ("hidden" "HIDDEN" simula-expand-keyword)
  1415.         ("histd" "HistD" simula-expand-stdproc)
  1416.         ("histo" "Histo" simula-expand-stdproc)
  1417.         ("hold" "Hold" simula-expand-stdproc)
  1418.         ("idle" "Idle" simula-expand-stdproc)
  1419.         ("if" "IF" simula-expand-keyword)
  1420.         ("image" "Image" simula-expand-stdproc)
  1421.         ("imagefile" "ImageFile" simula-expand-stdproc)
  1422.         ("imp" "IMP" simula-expand-keyword)
  1423.         ("in" "IN" simula-expand-keyword)
  1424.         ("inbyte" "InByte" simula-expand-stdproc)
  1425.         ("inbytefile" "InByteFile" simula-expand-stdproc)
  1426.         ("inchar" "InChar" simula-expand-stdproc)
  1427.         ("infile" "InFile" simula-expand-stdproc)
  1428.         ("infrac" "InFrac" simula-expand-stdproc)
  1429.         ("inimage" "InImage" simula-expand-stdproc)
  1430.         ("inint" "InInt" simula-expand-stdproc)
  1431.         ("inner" "INNER" simula-expand-keyword)
  1432.         ("inreal" "InReal" simula-expand-stdproc)
  1433.         ("inrecord" "InRecord" simula-expand-stdproc)
  1434.         ("inspect" "INSPECT" simula-expand-keyword)
  1435.         ("integer" "INTEGER" simula-expand-keyword)
  1436.         ("intext" "InText" simula-expand-stdproc)
  1437.         ("into" "Into" simula-expand-stdproc)
  1438.         ("is" "IS" simula-expand-keyword)
  1439.         ("isochar" "ISOChar" simula-expand-stdproc)
  1440.         ("isopen" "IsOpen" simula-expand-stdproc)
  1441.         ("isorank" "ISORank" simula-expand-stdproc)
  1442.         ("label" "LABEL" simula-expand-keyword)
  1443.         ("last" "Last" simula-expand-stdproc)
  1444.         ("lastitem" "LastItem" simula-expand-stdproc)
  1445.         ("lastloc" "LastLoc" simula-expand-stdproc)
  1446.         ("le" "LE" simula-expand-keyword)
  1447.         ("length" "Length" simula-expand-stdproc)
  1448.         ("letter" "Letter" simula-expand-stdproc)
  1449.         ("line" "Line" simula-expand-stdproc)
  1450.         ("linear" "Linear" simula-expand-stdproc)
  1451.         ("linesperpage" "LinesPerPage" simula-expand-stdproc)
  1452.         ("link" "Link" simula-expand-stdproc)
  1453.         ("linkage" "Linkage" simula-expand-stdproc)
  1454.         ("ln" "Ln" simula-expand-stdproc)
  1455.         ("locate" "Locate" simula-expand-stdproc)
  1456.         ("location" "Location" simula-expand-stdproc)
  1457.         ("lock" "Lock" simula-expand-stdproc)
  1458.         ("locked" "Locked" simula-expand-stdproc)
  1459.         ("log10" "Log10" simula-expand-stdproc)
  1460.         ("long" "LONG" simula-expand-keyword)
  1461.         ("lowcase" "LowCase" simula-expand-stdproc)
  1462.         ("lowerbound" "LowerBound" simula-expand-stdproc)
  1463.         ("lowten" "LowTen" simula-expand-stdproc)
  1464.         ("lt" "LT" simula-expand-keyword)
  1465.         ("main" "Main" simula-expand-stdproc)
  1466.         ("max" "Max" simula-expand-stdproc)
  1467.         ("maxint" "MaxInt" simula-expand-stdproc)
  1468.         ("maxlongreal" "MaxLongReal" simula-expand-stdproc)
  1469.         ("maxloc" "MaxLoc" simula-expand-stdproc)
  1470.         ("maxrank" "MaxRank" simula-expand-stdproc)
  1471.         ("maxreal" "MaxReal" simula-expand-stdproc)
  1472.         ("min" "Min" simula-expand-stdproc)
  1473.         ("minint" "MinInt" simula-expand-stdproc)
  1474.         ("minlongreal" "MinLongReal" simula-expand-stdproc)
  1475.         ("minrank" "MinRank" simula-expand-stdproc)
  1476.         ("minreal" "MinReal" simula-expand-stdproc)
  1477.         ("mod" "Mod" simula-expand-stdproc)
  1478.         ("more" "More" simula-expand-stdproc)
  1479.         ("name" "NAME" simula-expand-keyword)
  1480.         ("ne" "NE" simula-expand-keyword)
  1481.         ("negexp" "NegExp" simula-expand-stdproc)
  1482.         ("new" "NEW" simula-expand-keyword)
  1483.         ("nextev" "NextEv" simula-expand-stdproc)
  1484.         ("none" "NONE" simula-expand-keyword)
  1485.         ("normal" "Normal" simula-expand-stdproc)
  1486.         ("not" "NOT" simula-expand-keyword)
  1487.         ("notext" "NOTEXT" simula-expand-keyword)
  1488.         ("open" "Open" simula-expand-stdproc)
  1489.         ("or" "OR" simula-expand-keyword)
  1490.         ("otherwise" "OTHERWISE" simula-electric-keyword)
  1491.         ("out" "Out" simula-expand-stdproc)
  1492.         ("outbyte" "OutByte" simula-expand-stdproc)
  1493.         ("outbytefile" "OutByteFile" simula-expand-stdproc)
  1494.         ("outchar" "OutChar" simula-expand-stdproc)
  1495.         ("outfile" "OutFile" simula-expand-stdproc)
  1496.         ("outfix" "OutFix" simula-expand-stdproc)
  1497.         ("outfrac" "OutFrac" simula-expand-stdproc)
  1498.         ("outimage" "OutImage" simula-expand-stdproc)
  1499.         ("outint" "OutInt" simula-expand-stdproc)
  1500.         ("outreal" "OutReal" simula-expand-stdproc)
  1501.         ("outrecord" "OutRecord" simula-expand-stdproc)
  1502.         ("outtext" "OutText" simula-expand-stdproc)
  1503.         ("page" "Page" simula-expand-stdproc)
  1504.         ("passivate" "Passivate" simula-expand-stdproc)
  1505.         ("poisson" "Poisson" simula-expand-stdproc)
  1506.         ("pos" "Pos" simula-expand-stdproc)
  1507.         ("precede" "Precede" simula-expand-stdproc)
  1508.         ("pred" "Pred" simula-expand-stdproc)
  1509.         ("prev" "Prev" simula-expand-stdproc)
  1510.         ("printfile" "PrintFile" simula-expand-stdproc)
  1511.         ("prior" "PRIOR" simula-expand-keyword)
  1512.         ("procedure" "PROCEDURE" simula-expand-keyword)
  1513.         ("process" "Process" simula-expand-stdproc)
  1514.         ("protected" "PROTECTED" simula-expand-keyword)
  1515.         ("putchar" "PutChar" simula-expand-stdproc)
  1516.         ("putfix" "PutFix" simula-expand-stdproc)
  1517.         ("putfrac" "PutFrac" simula-expand-stdproc)
  1518.         ("putint" "PutInt" simula-expand-stdproc)
  1519.         ("putreal" "PutReal" simula-expand-stdproc)
  1520.         ("qua" "QUA" simula-expand-keyword)
  1521.         ("randint" "RandInt" simula-expand-stdproc)
  1522.         ("rank" "Rank" simula-expand-stdproc)
  1523.         ("reactivate" "REACTIVATE" simula-expand-keyword)
  1524.         ("real" "REAL" simula-expand-keyword)
  1525.         ("ref" "REF" simula-expand-keyword)
  1526.         ("resume" "Resume" simula-expand-stdproc)
  1527.         ("setaccess" "SetAccess" simula-expand-stdproc)
  1528.         ("setpos" "SetPos" simula-expand-stdproc)
  1529.         ("short" "SHORT" simula-expand-keyword)
  1530.         ("sign" "Sign" simula-expand-stdproc)
  1531.         ("simset" "SimSet" simula-expand-stdproc)
  1532.         ("simulaid" "SimulaId" simula-expand-stdproc)
  1533.         ("simulation" "Simulation" simula-expand-stdproc)
  1534.         ("sin" "Sin" simula-expand-stdproc)
  1535.         ("sinh" "SinH" simula-expand-stdproc)
  1536.         ("sourceline" "SourceLine" simula-expand-stdproc)
  1537.         ("spacing" "Spacing" simula-expand-stdproc)
  1538.         ("sqrt" "Sqrt" simula-expand-stdproc)
  1539.         ("start" "Start" simula-expand-stdproc)
  1540.         ("step" "STEP" simula-expand-keyword)
  1541.         ("strip" "Strip" simula-expand-stdproc)
  1542.         ("sub" "Sub" simula-expand-stdproc)
  1543.         ("subepsilon" "SubEpsilon" simula-expand-stdproc)
  1544.         ("suc" "Suc" simula-expand-stdproc)
  1545.         ("switch" "SWITCH" simula-expand-keyword)
  1546.         ("sysin" "SysIn" simula-expand-stdproc)
  1547.         ("sysout" "SysOut" simula-expand-stdproc)
  1548.         ("tan" "Tan" simula-expand-stdproc)
  1549.         ("tanh" "TanH" simula-expand-stdproc)
  1550.         ("terminate_program" "Terminate_Program" simula-expand-stdproc)
  1551.         ("terminated" "Terminated" simula-expand-stdproc)
  1552.         ("text" "TEXT" simula-expand-keyword)
  1553.         ("then" "THEN" simula-electric-keyword)
  1554.         ("this" "THIS" simula-expand-keyword)
  1555.         ("time" "Time" simula-expand-stdproc)
  1556.         ("to" "TO" simula-expand-keyword)
  1557.         ("true" "TRUE" simula-expand-keyword)
  1558.         ("uniform" "Uniform" simula-expand-stdproc)
  1559.         ("unlock" "Unlock" simula-expand-stdproc)
  1560.         ("until" "UNTIL" simula-expand-keyword)
  1561.         ("upcase" "Upcase" simula-expand-stdproc)
  1562.         ("upperbound" "UpperBound" simula-expand-stdproc)
  1563.         ("value" "VALUE" simula-expand-keyword)
  1564.         ("virtual" "VIRTUAL" simula-expand-keyword)
  1565.         ("wait" "Wait" simula-expand-stdproc)
  1566.         ("when" "WHEN" simula-electric-keyword)
  1567.         ("while" "WHILE" simula-expand-keyword))))
  1568.  
  1569. (if (and (fboundp 'hilit-set-mode-patterns)
  1570.      (boundp 'hilit-patterns-alist)
  1571.      (not (assoc 'simula-mode hilit-patterns-alist)))
  1572.     (hilit-set-mode-patterns
  1573.      'simula-mode
  1574.      '(
  1575.        ("^%\\([ \t\f].*\\)?$" nil comment)
  1576.        ("^%include\\>" nil include)
  1577.        ("\"[^\"\n]*\"\\|'.'\\|'![0-9]+!'" nil string)
  1578.        ("\\<\\(ACTIVATE\\|AFTER\\|AND\\|ARRAY\\|AT\\|BEFORE\\|BEGIN\\|BOOLEAN\\|CHARACTER\\|CLASS\\|DELAY\\|DO\\|ELSE\\|END\\|EQ\\|EQV\\|EXTERNAL\\|FALSE\\|FOR\\|GE\\|GO\\|GOTO\\|GT\\|HIDDEN\\|IF\\|IMP\\|IN\\|INNER\\|INSPECT\\|INTEGER\\|IS\\|LABEL\\|LE\\|LONG\\|LT\\|NAME\\|NE\\|NEW\\|NONE\\|NOT\\|NOTEXT\\|OR\\|OTHERWISE\\|PRIOR\\|PROCEDURE\\|PROTECTED\\|QUA\\|REACTIVATE\\|REAL\\|REF\\|SHORT\\|STEP\\|SWITCH\\|TEXT\\|THEN\\|THIS\\|TO\\|TRUE\\|UNTIL\\|VALUE\\|VIRTUAL\\|WHEN\\|WHILE\\)\\>" nil keyword)
  1579.        ("!\\|\\<COMMENT\\>" ";" comment))
  1580.      nil 'case-insensitive))
  1581.  
  1582. (setq simula-find-comment-point -1
  1583.       simula-find-comment-context nil)
  1584.  
  1585. ;; function used by hilit19
  1586. (defun simula-find-next-comment-region (param)
  1587.   "Return region (start end) cons of comment after point, or NIL"
  1588.   (let (start end)
  1589.     ;; This function is called repeatedly, check if point is
  1590.     ;; where we left it in the last call
  1591.     (if (not (eq simula-find-comment-point (point)))
  1592.     (setq simula-find-comment-point (point)
  1593.           simula-find-comment-context (simula-context)))
  1594.     ;; loop as long as we haven't found the end of a comment
  1595.     (if (memq simula-find-comment-context '(0 1 2))
  1596.     (setq start (point))
  1597.       (if (re-search-forward "\\<end\\>\\|!\\|\"\\|'\\|^%\\|\\<comment\\>"
  1598.                  nil 'move)
  1599.       (let ((previous-char (preceding-char)))
  1600.         (cond
  1601.          ((memq previous-char '(?d ?D))
  1602.           (setq start (point)
  1603.             simula-find-comment-context 2))
  1604.          ((memq previous-char '(?t ?T ?\!))
  1605.           (setq start (point)
  1606.             simula-find-comment-context 0))
  1607.          ((eq previous-char ?%)
  1608.           (setq start (point)
  1609.             simula-find-comment-context 0))))))
  1610.     ;; BUG: the following (0 2) branches don't take into account intermixing
  1611.     ;; directive lines
  1612.     (cond
  1613.      ((eq simula-find-comment-context 0)
  1614.       (search-forward ";" nil 'move))
  1615.      ((eq simula-find-comment-context 1)
  1616.       (beginning-of-line 2))
  1617.      ((eq simula-find-comment-context 2)
  1618.       (re-search-forward ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>\\" (point-max) 'move)))
  1619.     (if start
  1620.     (setq end (point)))
  1621.     ;; save point for later calls to this function
  1622.     (setq simula-find-comment-point (if end (point) -1))
  1623.     (and end (cons start end))))
  1624.  
  1625. (if (not (fboundp 'save-match-data))
  1626.     (defmacro save-match-data (&rest body)
  1627.       "Execute the BODY forms, restoring the global value of the match data."
  1628.       (let ((original (make-symbol "match-data")))
  1629.     (list
  1630.      'let (list (list original '(match-data)))
  1631.      (list 'unwind-protect
  1632.            (cons 'progn body)
  1633.            (list 'store-match-data original))))))
  1634.  
  1635.  
  1636. ;; defuns for submitting bug reports
  1637.  
  1638. (defconst simula-mode-help-address "simula-mode@ifi.uio.no"
  1639.   "Address accepting submission of simula-mode bug reports.")
  1640.  
  1641. ;; get reporter-submit-bug-report when byte-compiling
  1642. (and (fboundp 'eval-when-compile)
  1643.      (eval-when-compile
  1644.       (require 'reporter)))
  1645.  
  1646. (defun simula-submit-bug-report ()
  1647.   "Submit via mail a bug report on simula-mode."
  1648.   (interactive)
  1649.   (and
  1650.    (y-or-n-p "Do you want to submit a report on simula-mode? ")
  1651.    (require 'reporter)
  1652.    (reporter-submit-bug-report
  1653.     simula-mode-help-address
  1654.     (concat "simula-mode from Emacs " emacs-version)
  1655.     (list
  1656.      ;; report only the vars that affect indentation
  1657.      'simula-emacs-features
  1658.      'simula-indent-level
  1659.      'simula-substatement-offset
  1660.      'simula-continued-statement-offset
  1661.      'simula-label-offset
  1662.      'simula-if-indent
  1663.      'simula-inspect-indent
  1664.      'simula-electric-indent
  1665.      'simula-abbrev-keyword
  1666.      'simula-abbrev-stdproc
  1667.      'simula-abbrev-file
  1668.      'simula-tab-always-indent
  1669.      ))))
  1670.  
  1671. (provide 'simula-mode)
  1672.  
  1673. ;;; simula.el ends here
  1674.